import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intercalate)

splitAll :: Eq a => [a] -> [a] -> [[a]]
splitAll _ [] = []
splitAll delims xs = 
    token : splitAll delims rest
    where
        isDelimiter = (`elem` delims)
        token       = takeWhile (not . isDelimiter) xs
        rest        = dropWhile isDelimiter $ dropWhile (not . isDelimiter) xs

type Counter = Map.Map String Int
type Record  = Map.Map String (Set.Set String)

-- vmmzf hff zjtdlhx ncdkz (contains nuts, sesame, dairy)
parseLine :: String -> ([String], [String])
parseLine str = (ingredients, allergens)
    where
        ingredients = splitAll " " . takeWhile (/='(') $ str
        allergens   = splitAll ", " . init . drop 10 . dropWhile (/='(') $ str   

parseInput :: String -> [([String], [String])]
parseInput = map parseLine . lines

flatIngredients :: [([String], [String])] -> [String]
flatIngredients = concat . map fst 

getCounter :: [String] -> Counter
getCounter = foldl foldFunc Map.empty 
    where
        foldFunc :: Counter -> String -> Counter
        foldFunc counter str = case Map.lookup str counter of
            Just count -> Map.insert str (count+1) counter
            Nothing    -> Map.insert str 1 counter

getAllergenMayFrom :: [([String], [String])] -> Record
getAllergenMayFrom = foldl foldFunc Map.empty 
    where
        foldFunc :: Record -> ([String], [String]) -> Record
        foldFunc record (ingredients, allergens) = 
            foldl checkAllergen record allergens
            where
                checkAllergen :: Record -> String -> Record
                checkAllergen record allergen = 
                    case Map.lookup allergen record of
                        Just maybeIngredients -> Map.insert allergen (Set.intersection maybeIngredients ingredientSet) record
                        Nothing -> Map.insert allergen ingredientSet record
        
                ingredientSet = Set.fromList ingredients

getEnsureAllergens :: Record -> [(String, String)]
getEnsureAllergens record = map (\(a, is) -> (a, head $ Set.toList is)) 
                          . filter filterFunc 
                          $ Map.toList record
    where
        filterFunc :: (String, (Set.Set String)) -> Bool
        filterFunc (_, ingredients) = length ingredients == 1

removeAllergens :: Record -> [(String, String)] -> Record
removeAllergens record ensuredAllIngs = 
    Map.filterWithKey (\a _ -> not $ a `elem` allergens) record 
    where
        allergens = map fst ensuredAllIngs

removeEnsuredAllergens :: Record -> [(String, String)] -> Record
removeEnsuredAllergens record ensuredAllIngs = Map.map mapFunc record
    where
        ensuredIngredients = Set.fromList $ map snd ensuredAllIngs
        mapFunc = (`Set.difference` ensuredIngredients)

doSolve :: (Record, [(String, String)]) -> (Record, [(String, String)])
doSolve (record, result) = 
    if length record == 0 
        then (record, result)
        else doSolve (record'', result ++ ensureAIs)
    where
        ensureAIs = getEnsureAllergens record
        record'   = removeAllergens record ensureAIs
        record''  = removeEnsuredAllergens record' ensureAIs

solve :: Record -> [(String, String)]
solve record = snd $ doSolve (record, [])

main :: IO ()
main = do
    input <- readFile "input.txt"

    print . intercalate ","
          . map snd  
          . solve 
          . getAllergenMayFrom
          . parseInput
          $ input
